home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SHELLS / SZ2 / EXECPROC.PAS < prev    next >
Pascal/Delphi Source File  |  1992-08-31  |  7KB  |  177 lines
  1. {$I compiler }
  2. {$O-}
  3. UNIT ExecProc;INTERFACE USES Overlay,Dos,
  4.                              Memory,Objects,Buffers;
  5.    {*******************************************************************
  6.    EXECPROC.PAS, Version 2.1   Copyright (c) 1991,92 Johnathan J. Stein
  7.                                           All Rights Reserved WorldWide
  8.                                            STEIN RESEARCH & ENGINEERING
  9.                                                     Post Office Box 346
  10.                                                    Perrysburg, OH 43552
  11.                                                      Voice 419-666-7103
  12.                                                      Fax   419-874-4922
  13.    Only for use by Licensed Users of SHAZAM.       CompuServe 76576,470
  14.    *******************************************************************}
  15.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  16.    Automate use of procedure pointers.
  17.    [X] ExecPROC.Exec defaults to normal exec if SWAP fails
  18.    [X] ExecPROC.Exec recovers overlay space via SHAZAM "Remap"
  19.  
  20.    Related:  see "function VisionExec..." in GENERAL.PAS
  21.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  22.    {===================================================================
  23.    So we can call EXECSWAP without USES complications.
  24.    ===================================================================}
  25. TYPE
  26.    TInitExecSwap             = function ( P : pointer ;
  27.                                           S : string ) : boolean ;
  28.    TExecWithSwap             = function ( S1 ,
  29.                                           S2 : string ) : word ;
  30.    TShutDownExecSwap         = procedure ;
  31. VAR
  32.    InitExecSwap              : TInitExecSwap ;         
  33.    ExecWithSwap              : TExecWithSwap ;         
  34.    ShutDownExecSwap          : TShutDownExecSwap ;     
  35. CONST
  36.    SwapFileName              : string = 'SWAP.$$$' ;
  37.    UseExecSwap               : boolean = TRUE ;
  38.    UseEMSSwap                : boolean = TRUE ;
  39.  
  40. function BuffersInUse        : boolean ;
  41. function OverlaysInUse       : boolean ;
  42. function RemapInUse          : boolean ;
  43. function Exec                ( Path , CmdLine : string ) : word ;
  44.  
  45. IMPLEMENTATION
  46.  
  47.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  48.  
  49.    MEMORY - information
  50.  
  51.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  52.    {===================================================================
  53.  
  54.    BUFFERS - test for special heap management
  55.  
  56.    ===================================================================}
  57. function BuffersInUse : boolean ;
  58. begin
  59.    BuffersInUse              := ( PtrRec ( HeapEnd ).Seg <> BufHeapEnd ) and
  60.                                 ( BufHeapEnd <> 0 ) ;
  61. end ;
  62.    {===================================================================
  63.  
  64.    OVERLAYS - test for presence of overlays
  65.  
  66.    ===================================================================}
  67. function OverlaysInUse : boolean ;
  68. begin
  69.    OverlaysInUse             := OvrGetBuf <> 0 ;
  70. end ;
  71.    {===================================================================
  72.  
  73.    REMAP - test for overlay buffer at top of memory
  74.  
  75.    ===================================================================}
  76. function RemapInUse : boolean ;
  77. begin
  78.    RemapInUse                := PtrRec ( HeapOrg ).Seg < OvrHeapEnd ;
  79. end ;
  80.    {|||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||
  81.  
  82.    EXEC - DosError holds result.  Function returns DosExitCode of child
  83.           process.  If SHAZAM RemapMemory is active, then non-swap EXEC
  84.           recovers overlay heap.
  85.  
  86.    |||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||||}
  87.    {===================================================================
  88.  
  89.    SWAP
  90.  
  91.    ===================================================================}
  92. function SwapOK ( Path , CmdLine : string ) : word ;
  93. var
  94.    AvailPtr                  : pointer ;
  95. begin
  96.    SwapFileName              := FExpand ( SwapFileName ) ;
  97.    SwapOK                    := $FFFF ;
  98.    if not UseExecSwap then EXIT ;
  99.    if @InitExecSwap = NIL then EXIT ;
  100.    if BuffersInUse then
  101.       AvailPtr               := Ptr ( BufHeapPtr , 0 )
  102.    else
  103.       AvailPtr               := HeapPtr ;
  104.    if not InitExecSwap ( AvailPtr , SwapFileName ) then EXIT ;
  105.    SwapVectors ;
  106.    OvrClearBuf ;
  107.    DosError                  := WORD ( ExecWithSwap ( Path , CmdLine ) ) ;
  108.    SwapVectors ;
  109.    SwapOK                    := DOS.DosExitCode ;
  110.    ShutdownExecSwap ;
  111. end ;
  112.    {===================================================================
  113.  
  114.    EXEC - returns "DosExitCode".
  115.  
  116.    ===================================================================}
  117. function Exec ( Path , CmdLine : string ) : word ;
  118. var
  119.    AvailPtr                  : pointer ;
  120.    EndPtr                    : pointer ;
  121.    TempDosExitCode           : word ;
  122. begin
  123.    DosError                  := 0 ;
  124.    TempDosExitCode           := SwapOK ( Path , CmdLine ) ;
  125.    if TempDosExitCode <> $FFFF then
  126.    begin
  127.       Exec                   := TempDosExitCode ;
  128.       EXIT ;
  129.    end ;
  130.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  131.    AvailPtr = UNUSED MEMORY
  132.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  133.    if BuffersInUse then
  134.       AvailPtr               := Ptr ( BufHeapPtr , 0 )
  135.    else
  136.       AvailPtr               := HeapPtr ;
  137.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  138.    EndPtr = Top Of Memory
  139.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  140.    if OverlaysInUse and RemapInUse then
  141.       EndPtr                 := Ptr ( OvrHeapEnd , 0 )
  142.    else
  143.       if BuffersInUse then
  144.          EndPtr              := Ptr ( BufHeapEnd , 0 )
  145.       else
  146.          EndPtr              := HeapEnd ;
  147.    SetMemTop ( AvailPtr ) ;
  148.    SwapVectors ;
  149.    OvrClearBuf ;
  150.    DOS.Exec ( Path , CmdLine ) ;
  151.    TempDosExitCode           := DOS.DosExitCode ;
  152.    Exec                      := TempDosExitCode ;
  153.    SwapVectors ;
  154.    {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  155.    Restore memory allocation
  156.    - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  157.    SetMemTop ( EndPtr ) ;
  158. end ;
  159.    {===================================================================
  160.    The EXECSWAP unit MUST assign addresses to procedures.  If it is NOT
  161.    used, this unit will maximize memory available anyway.  Also useful
  162.    when EXECSWAP is used, but cannot create swap file (such as running
  163.    on a write-protected floppy.)
  164.    ===================================================================}
  165. procedure InstallExec ;
  166. begin
  167.    FillChar ( InitExecSwap , SizeOf ( InitExecSwap ) , #0 ) ;
  168.    FillChar ( ExecWithSwap , SizeOf ( ExecWithSwap ) , #0 ) ;
  169.    FillChar ( ShutDownExecSwap , SizeOf ( ShutDownExecSwap ) , #0 ) ;
  170. end ;
  171.    {^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
  172.    INITIALIZATION
  173.    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^}
  174. BEGIN
  175.    InstallExec ;
  176. END.
  177.